Amiga Plus 2002 #11/Amiga Plus CD - 2002 - No. 11.iso/Tools/Development/PowerD/powerd/source/dmod.d

Text File | 2002-10-28 | 12.5 KB | 604 lines

// view powerd binary module (#?.b) generated by powerd v0.12 and later

// 1.0 initial release
// 1.1 (27.1.2001)
//   added unions (in binary modules introduced with PowerD 0.17)
// 1.2 (29.12.2001)
//   added support for structs and cunions
//   improved object layout
// 1.3 (18.1.2002)
//   added support for multidimensional items in objects (introduced in dc 0.19alpha5)
//   added TDEF support
//   added OFFSET/RELOFS/ALIGN keywords support in OBJECTs

BYTE 0,0,'$VER:dmod v1.3 by MarK (18.1.2002)',0,0

PROC DisplayMODULE(mem:PTR TO CHAR)
    DEF    ver,rev,count,nl,ml,namelist:PTR TO CHAR,type,flags,acount,rcount,l,offset,
            base:PTR TO CHAR

    IF Long(mem)<>"DMOD"
        PrintF('\s: unknown filetype','dmod')
        RETURN
    ENDIF
    mem+=4                        // skip "DMOD"
    ver:=Word(mem)
    rev:=Word(mem+2)
    mem+=4                        // skip ver,rev
    PrintF('// requied version of powerd: v\d.\z\d[2]\n\n',ver,rev)

    IF Long(mem)="MODS"
        PrintF('MODULE\t')
        count:=Word(mem+4)
        mem+=6
        WHILE count
            count--
            nl:=Word(mem)
            mem+=2
            PrintF('''\s''',mem)
            mem+=nl+1
            IF Odd(mem) THEN mem++
            IF CtrlC() THEN RETURN
        EXITIF count=0 DO PrintF('\n\n')
            PrintF(',\n\t\t\t')
        ENDWHILE
    ENDIF

    IF Long(mem)="CNST"                // constant list
        PrintF('CONST\t')
        count:=Word(mem+4)            // count of constants
        ml:=Long(mem+6)
        nl:=Long(mem+10)
        mem+=14
        namelist:=mem+ml
        WHILE count
            count--
            PrintF('\s=',namelist)
            type:=UByte(mem++)
            flags:=UByte(mem++)
            IF type=$ff
                PrintF('0')
            ELSEIF type=8                // DT_DOUBLE
                PrintF('$\z\h[8].\z\h[8]',Long(mem),Long(mem+4))
                mem+=8
            ELSEIF flags&%10            // S_TAG
                PrintF('$\h',Word(mem)|$80000000)
                mem+++
            ELSEIF type=3                // DT_WORD
                PrintF('\d',Word(mem))
                mem+++
            ELSE
                acount:=Long(mem)
                PrintF(IF acount>=-32768 AND acount<=32767 THEN '\d' ELSE '$\h',acount)
//                PrintF(IF Long(mem)>=-32768 AND Long(mem)<=32767 THEN '\d' ELSE '$\h',Long(mem))
                mem+=4
            ENDIF
            namelist+=StrLen(namelist)+1
            IF namelist[0]="\0" THEN namelist++
            IF CtrlC() THEN RETURN
        EXITIF count=0 DO PrintF('\n\n')
            PrintF(',\n\t\t')
        ENDWHILE
        IF Odd(namelist) THEN namelist++
        mem:=namelist
    ENDIF

    IF Long(mem)="OBJC"            -> object list
        ml:=Long(mem+4)
        nl:=Long(mem+8)
        acount:=Word(mem+12)
        count:=Word(mem+14)
        mem+=16
        namelist:=mem+ml
        offset:=0

        WHILE acount
            mem,namelist:=LoadOBJECT(mem,namelist,offset)
            acount--
            IF CtrlC() THEN RETURN
        ENDWHILE

        IF Odd(namelist) THEN namelist++
        mem:=namelist
    ENDIF

    IF Long(mem)="#def"            -> #define list
        count:=Word(mem+4)
        acount:=Word(mem+6)
        ml:=Long(mem+8)
        nl:=Long(mem+12)
        mem+=16
        namelist:=mem+ml

        WHILE count
            count--
            PrintF('#define \s',namelist)
            namelist+=mem[1]+1
            l:=Word(mem+2)
            acount:=mem[0]
            mem+=4
            IF acount
                PrintF('(')
                WHILE acount
                    PrintF('\s',namelist)
                    namelist+=mem[1]+1
                    mem+++
                    acount--
                    IF CtrlC() THEN RETURN
                EXITIF acount=0 DO PrintF(') ')
                    PrintF(',')
                ENDWHILE
            ELSE PrintF(' ')
            PrintF('\s\n',namelist)
            namelist+=l+1
            IF CtrlC() THEN RETURN
        ENDWHILE

        IF Odd(namelist) THEN namelist++
        mem:=mem+nl
    ENDIF

    IF Long(mem)="LIBR"            // function list
        count:=Word(mem+4)        // count of functions
        nl:=Word(mem+6)            // base name length
        ml:=Long(mem+12)            // block length
        mem+=16
        base:=mem
        mem+=nl
        IF mem[0]="\0" THEN mem++
        namelist:=mem+ml
        PrintF('LIBRARY \s\n\t',base)

        WHILE count
            count--
            offset:=Word(mem)
            acount:=mem[2]
            rcount:=mem[3]&$1f
            ver:=mem[3]>>5            // get ppc function type
            SELECT ver
            CASE 0;    PrintF('M68K,')
            CASE 1;    PrintF('PPC,')
            CASE 2;    PrintF('PPC2,')
            CASE 3;    PrintF('PPC0,')
            ENDSELECT
            mem+=4
            PrintF('\s(',namelist)
            namelist+=StrLen(namelist)+1
            WHILE acount
                acount--
                IF ver
                    SELECT mem[2]
                    CASE 0 TO 31;    PrintF('r\d',mem[2]&%11111)
                    CASE 32 TO 63;    PrintF('f\d',mem[2]&%11111)
                    ENDSELECT
                ELSE
                    SELECT mem[2]
                    CASE 0 TO 7;    PrintF('d\d',mem[2]&%111)
                    CASE 8 TO 15;    PrintF('a\d',mem[2]&%111)
                    CASE 16 TO 23;    PrintF('fp\d',mem[2]&%111)
                    ENDSELECT
                ENDIF
                type:=mem[0]
                flags:=mem[1]        // means default value set
                nl:=mem[3]
                mem+=4
                IF flags
                    IF type=8
                        PrintF('=$\z\h[8].\z\h[8]',Long(mem),Long(mem+4))
                        mem+=8
                    ELSE
                        PrintF('=$\d',Long(mem))
                        mem+=4
                    ENDIF
                ENDIF
                IF type
                    PrintF(':\s',TypeStr(type))
                ENDIF
                IF nl
                    PrintF('\s',namelist)
                    namelist+=nl+1
                ENDIF
            EXITIF acount=0
                PrintF(',')
                IF CtrlC() THEN RETURN
            ENDWHILE
            PrintF(')')

            IF rcount
                PrintF('(')
                WHILE rcount
                    rcount--
                    IF ver
                        SELECT mem[2]
                        CASE 0 TO 31;    PrintF('r\d',mem[2]&%11111)
                        CASE 32 TO 63;    PrintF('f\d',mem[2]&%11111)
                        ENDSELECT
                    ELSE
                        SELECT mem[2]
                        CASE 0 TO 7;    PrintF('d\d',mem[2]&%111)
                        CASE 8 TO 15;    PrintF('a\d',mem[2]&%111)
                        CASE 16 TO 23;    PrintF('fp\d',mem[2]&%111)
                        ENDSELECT
                    ENDIF
                    type:=mem[0]
                    nl:=mem[3]
                    mem+=4
                    IF type
                        PrintF(':\s',TypeStr(type))
                    ENDIF
                    IF nl
                        PrintF('\s',namelist)
                        namelist+=nl+1
                    ENDIF
                EXITIF rcount=0 DO PrintF(')')
                    PrintF(',')
                    IF CtrlC() THEN RETURN
                ENDWHILE
            ENDIF
            PrintF('=\d',offset)
            IF CtrlC() THEN RETURN
        EXITIF count=0 DO PrintF('\n\n')
            PrintF(',\n\t')
        ENDWHILE
        IF Odd(namelist) THEN namelist++
        mem:=namelist
    ENDIF

    IF Long(mem)="EXPR"            // external function list
        count:=Word(mem+4)
        ml:=Long(mem+10)
        nl:=Long(mem+14)
        mem+=18
        namelist:=mem+ml

        WHILE count
            count--
            SELECT type:=mem[0]
            CASE 11;    PrintF('EPROC')
            CASE 13;    PrintF('LPROC')
            CASE 14;    PrintF('RPROC')
            ENDSELECT
/*
            IF StrCmp(namelist,'Ror')
                xxxxxx:
                l:=l
            ENDIF
*/
            PrintF(' \s(',namelist)
            namelist+=StrLen(namelist)+1
            flags:=mem[1]
            acount:=mem[2]
            rcount:=mem[3]
            mem+=4
            offset:=0
            IF flags&%01
                offset:=namelist
                namelist+=StrLen(namelist)+1
            ENDIF

            IF type=14
                IF flags&%10
                    l:=namelist
                    namelist+=StrLen(namelist)+1
                ELSE
                    l:=NIL
                ENDIF
            ENDIF

            WHILE acount
                acount--
                type:=mem[0]
                flags:=mem[1]
                SELECT mem[3]
                CASE 0 TO 7;    PrintF('d\d',mem[3]&%111)
                CASE 8 TO 15;    PrintF('a\d',mem[3]&%111)
                CASE 16 TO 23;    PrintF('fp\d',mem[3]&%111)
                DEFAULT;            PrintF('\c',"z"-acount)        // stack
                ENDSELECT
                mem+=4
                IF flags&%01
                    IF type=8    // DT_DOUBLE
                        PrintF('=$\z\h[8].\z\h[8]',Long(mem),Long(mem+4))
                        mem+=8
                    ELSE
                        PrintF('=\d',Long(mem))
                        mem+=4
                    ENDIF
                ENDIF
                IF type
                    PrintF(':\s',TypeStr(type))
                    IF flags&%10
                        PrintF('\s',namelist)
                        namelist+=StrLen(namelist)+1
                    ENDIF
                ENDIF
            EXITIF acount=0
                PrintF(',')
                IF CtrlC() THEN RETURN
            ENDWHILE
            PrintF(')')

            IF rcount
                PrintF('(')
                WHILE rcount
                    rcount--
                    type:=mem[0]
                    SELECT mem[1]
                    CASE 0 TO 7;    PrintF('d\d',mem[1]&%111)
                    CASE 8 TO 15;    PrintF('a\d',mem[1]&%111)
                    CASE 16 TO 23;    PrintF('fp\d',mem[1]&%111)
                    ENDSELECT
                    mem+++
                    IF type THEN PrintF(':\s',TypeStr(type))
                    IF type=10 OR type=42 OR type=74 OR type=138
                        PrintF('\s',namelist)
                        namelist+=StrLen(namelist)+1
                    ENDIF
                EXITIF rcount=0 DO PrintF(')')
                    PrintF(',')
                    IF CtrlC() THEN RETURN
                ENDWHILE
            ENDIF

            IF offset THEN PrintF(' OF \s',offset)
            IF l THEN PrintF('=''\s''',l)
            IF CtrlC() THEN RETURN
            PrintF('\n')
        ENDWHILE
        PrintF('\n')
        IF Odd(namelist) THEN namelist++
        mem+=nl
    ENDIF

    IF Long(mem)="EDEF"
        PrintF('EDEF\t')
        count:=Word(mem+4)
        ml:=Long(mem+6)
        nl:=Long(mem+10)
        mem+=14
        namelist:=mem+ml

        WHILE count
            count--
            PrintF('\s',namelist)
            namelist+=StrLen(namelist)+1
            IF mem[0] THEN PrintF(':\s',TypeStr(mem[0]))
            IF mem[1]
                PrintF('\s',namelist)
                namelist+=StrLen(namelist)+1
            ENDIF
            mem+++
        EXITIF count=0 DO PrintF('\n\n')
            PrintF(',\n\t\t')
            IF CtrlC() THEN RETURN
        ENDWHILE
        mem+=nl
    ENDIF

    IF Long(mem)="LINK"
        PrintF('OPT\t')
        count:=Word(mem+4)
        mem:=mem+6
        WHILE count
            count--
            nl:=Word(mem)
            mem+++
            PrintF('''\s''',mem)
            mem:=mem+nl
            IF Odd(nl) THEN mem++
        EXITIF count=0 DO PrintF('\n')
            PrintF(',\n\t\t')
            IF CtrlC() THEN RETURN
        ENDWHILE
    ENDIF

    IF Long(mem)="HEAD"
        nl:=Word(mem+4)
        mem+=6
        PrintF('OPT\tHEAD=''\s''\n',mem)
        mem+=nl
        IF Odd(nl) THEN mem++
    ENDIF

    IF Long(mem)="TDEF"
        PrintF('TDEF\t')
        count:=Word(mem+4)
        ml:=Long(mem+6)
        nl:=Long(mem+10)
        mem:=mem+14
        namelist:=mem+ml
        WHILE count
            PrintF('\s:\s',namelist,TypeStr(mem[0]))
            namelist+=mem[1]+1
            IF mem[2]
                PrintF(' \s',namelist)
                namelist+=mem[2]+1
            ENDIF
            mem+=4
            count--
            IF count THEN PrintF(',\n\t\t') ELSE PrintF('\n\n')
            IF CtrlC() THEN RETURN
        ENDWHILE
        mem+=nl
        IF Odd(mem) THEN mem++
    ENDIF

ENDPROC

PROC LoadOBJECT(mem:PTR TO CHAR,nmem:PTR TO CHAR,offset,depth=0)(PTR TO CHAR,PTR TO CHAR)
    DEF    count
    IF mem[0]=0        // next object
        do_depth
        PrintF('OBJECT \s',nmem)
        nmem+=mem[1]+1
        IF mem[2]
            PrintF(' OF \s\n',nmem)
            nmem+=mem[2]+1
        ELSE PrintF('\n')
        mem+=8
        WHILE mem[0]>=1 AND mem[0]<=5
            mem,nmem:=LoadOBJECT(mem,nmem,offset,depth+1)
        ELSEWHILE mem[0]>=6 AND mem[0]<=8
            mem,nmem:=LoadOBJECT(mem,nmem,offset,depth)
        ALWAYS
        EXITIF mem[0]<1 AND mem[0]>8 DO PrintF('\n\n')
            PrintF(',\n')
            IF CtrlC() THEN RETURN
        ENDWHILE
    ELSEIF mem[0]=1    // normal item
        do_depth
        PrintF('\s',nmem)
        nmem+=mem[1]+1
        IF Word(mem+6) THEN PrintF('[\d]',Word(mem+6))
        PrintF(':\s',TypeStr(mem[2]))
        IF mem[5]
            PrintF('\s',nmem)
            nmem+=mem[5]+1
        ENDIF
        mem+=10
    ELSEIF mem[0]=5    // normal multidimensional item
        do_depth
        PrintF('\s',nmem)
        nmem+=mem[1]+1
        IF Word(mem+6)
            PrintF('[\d',Word(mem+6))
            IF Word(mem+10)
                PrintF(',\d',Word(mem+10))
                IF Word(mem+12)
                    PrintF(',\d]',Word(mem+12))
                ELSE PrintF(']')
            ELSE PrintF(']')
        ENDIF
        PrintF(':\s',TypeStr(mem[2]))
        IF mem[5]
            PrintF('\s',nmem)
            nmem+=mem[5]+1
        ENDIF
        mem+=14
    ELSEIF mem[0]=2    // union/object
        DEF    first=TRUE
        WHILE mem[0]=2
            do_depth
            PrintF('\s \s\n',IF first THEN 'OBJECT' ELSE 'UNION',nmem)
            nmem+=mem[1]+1
            count:=mem[2]
            mem+=6
            WHILE count
                count--
                mem,nmem:=LoadOBJECT(mem,nmem,offset,depth+1)
                PrintF(IF (mem[0]=1 OR mem[0]=3) AND count>0 THEN ',\n' ELSE '\n')
                IF CtrlC() THEN RETURN
            ENDWHILE
            first:=FALSE
        ENDWHILE
        PrintF('\tENDOBJECT')
    ELSEIF mem[0]=3    // struct
        do_depth
        DEF    name
        count:=mem[2]
        offset:=Word(mem+4)
        name:=nmem
        nmem+=mem[1]+1
        mem+=6
        PrintF('[\n')
        WHILE count
            count--
            mem,nmem:=LoadOBJECT(mem,nmem,offset,depth+1)
            PrintF(IF count>0 THEN ',\n' ELSE '\n')
            IF CtrlC() THEN RETURN
        ENDWHILE
        do_depth
        PrintF(']:\s',name)
    ELSEIF mem[0]=4    // cunion
        count:=mem[1]
        mem+=4
        do_depth
        PrintF('CUNION\n')
        WHILE count
            count--
            mem,nmem:=LoadOBJECT(mem,nmem,offset,depth+1)
            PrintF(IF count>0 THEN ',\n' ELSE '\n')
            IF CtrlC() THEN RETURN
        ENDWHILE
        PrintF('\tENDUNION')
    ELSEIF mem[0]=6    // offset
        do_depth
        PrintF('OFFSET \d',Word(mem+2))
        mem+=4
    ELSEIF mem[0]=7    // relofs
        do_depth
        PrintF('RELOFS \d',Word(mem+2))
        mem+=4
    ELSEIF mem[0]=8    // offset
        do_depth
        IF Word(mem+2)=4
            PrintF('ALIGN')
        ELSE
            PrintF('ALIGN \d',Word(mem+2))
        ENDIF
        mem+=4
    ELSE
    ENDIF
    SUB do_depth
        DEF    dp=depth
        WHILE dp-- DO PrintF('\t')
    ENDSUB
ENDPROC mem,nmem

PROC TypeStr(type)(PTR TO CHAR)
    DEF    str2:PTR TO CHAR,cnt,str:PTR TO CHAR
    str2:='                                                                            '
    str2[0]:="\0"
    cnt:=(type & %11100000)>>5    // obtain the pointer count from the type
    IF cnt>4 THEN cnt--            // here we have to skip the DT_LIST type

    SELECT type&%00011111
    CASE 1;    str:='LONG'
    CASE 2;    str:='ULONG'
    CASE 3;    str:='WORD'
    CASE 4;    str:='UWORD'
    CASE 5;    str:='BYTE'
    CASE 6;    str:='UBYTE'
    CASE 7;    str:='FLOAT'
    CASE 8;    str:='DOUBLE'
    CASE 9;    str:='BOOL'
    CASE 10;    str:='\0'
    CASE 11;    str:='PTR'
    CASE 12;    str:='DLONG'
    CASE 13;    str:='UDLONG'
    CASE 14;    str:=IF type&%11100000 THEN 'CHAR' ELSE 'STRING'
    DEFAULT;    str:='VOID'
    ENDSELECT

    IF (type&%11100000)=%10000000
        StrCopy(str2,'LIST OF ')
    ELSE
        WHILE cnt
            StrAdd(str2,'PTR TO ')
            cnt--
        ENDWHILE
    ENDIF
    StrAdd(str2,str)
ENDPROC str2

MODULE    'exec/memory'

ENUM    SOURCE

PROC main()
    DEF    rda,args=[0,0]:LONG,l,m:PTR TO CHAR,f
    IF rda:=ReadArgs('SOURCE/A',args,NIL)
        l:=FileLength(args[SOURCE])
        IF f:=Open(args[SOURCE],OLDFILE)
            IF m:=AllocMem(l+8,MEMF_PUBLIC|MEMF_CLEAR)
                IF Read(f,m,l)=l
                    DisplayMODULE(m)
                ELSE PrintFault(IOErr(),'dmod')
                FreeMem(m,l+8)
            ELSE PrintF('\s: not enough memory\n','dmod')
            Close(f)
        ELSE PrintFault(IOErr(),'dmod')
        FreeArgs(rda)
    ELSE PrintFault(IOErr(),'dmod')
ENDPROC